home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / ada / adaed-1.11 / adaed-1 / Adaed-1.11.0a / 0b.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-02-07  |  21.0 KB  |  941 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9.  
  10. #include "hdr.h"
  11. #include "vars.h"
  12. #include "dbxprots.h"
  13. #include "errmsgprots.h"
  14. #include "dclmapprots.h"
  15. #include "miscprots.h"
  16. #include "smiscprots.h"
  17. #include "chapprots.h"
  18. #include <ctype.h>
  19. /* ctype.h needed for isupper, tolower, etc in 4.2 bsd*/
  20.  
  21. void adasem(Node node)                                            /*;adasem*/
  22. {
  23.     /* This is the driver routine for  all semantic processing. It is called
  24.      * by  the parser  whenever the syntax    tree  for a compilation unit has
  25.      * been built. The input  to this routine  is an AST node,  on which two
  26.      * maps are defined : AST, and SPANS. These maps are global to the front
  27.      * end.
  28.      */
  29.  
  30.     Node    n1, n2, n3, n4;
  31.     char    *id, *op_id;
  32.     Fortup    ft1;
  33.     Tuple    tup;
  34.     Node    decl_node, id_node, l;
  35.     Symbol    package, s1;
  36.  
  37.     if (cdebug2 > 2) {
  38.         /*    TO_ERRFILE("node type ");*/
  39. #ifdef IBM_PC
  40.         printf("node type: %s %d %p\n", kind_str(N_KIND(node)), N_KIND(node),
  41.           node);
  42. #else
  43.         printf("node type: %s %d %ld\n", kind_str(N_KIND(node)), N_KIND(node),
  44.           node);
  45. #endif
  46.     }
  47.  
  48.     /* The current node is placed in a global variable, from which the error
  49.      * routines can extract its span.
  50.      */
  51.     current_node = node;
  52.  
  53. #ifdef DEBUG
  54.     if (trapns>0 && N_SEQ(node) == trapns && N_UNIT(node) == trapnu)trapn(node);
  55. #endif
  56.     switch(N_KIND(node)) {
  57.  
  58.     /* Chapter 2. Lexical elements*/
  59.  
  60.     /* pragma  ->  [as_pragma  identifier argument_list]*/
  61.     case(as_pragma):
  62.         process_pragma(node);
  63.         break;
  64.  
  65.     /* argument_association     ->  [as_arg  identifier  expression]*/
  66.     case(as_arg):
  67.         break;            /*Unpacked in process_pragmas.*/
  68.  
  69.     /* Chapter 3. Declarations and types */
  70.  
  71.     /*  object_declaration ->  [as_obj_decl    identifier_list subtype_indic
  72.      *                            opt_expression]
  73.      */
  74.     case(as_obj_decl):
  75.         obj_decl(node);
  76.         break;
  77.  
  78.     /* const_declaration  ->  ['const_decl' identifier_list subtype_indic
  79.      *                            opt_expression]
  80.      */
  81.     case(as_const_decl):
  82.         const_decl(node);
  83.         break;
  84.  
  85.     /* num_declaration    ->  ['num_decl'  identifier_list expression]*/
  86.     case(as_num_decl):
  87.         number_decl(node);
  88.         break;
  89.  
  90.     /* type_decl  ->  ['type_decl' identifier discriminant_list
  91.      *                            type_definition]
  92.      */
  93.     case(as_type_decl):
  94.         type_decl(node);
  95.         break;
  96.  
  97.     /* Subtype_decl ->  ['subtype_decl' identifier subtype_indic]*/
  98.     case(as_subtype_decl):
  99.         subtype_decl(node);
  100.         break;
  101.  
  102.     /* subtype_indication  ->  ['subtype_indic', name opt_constraint]*/
  103.     case(as_subtype_indic):
  104.         /*[name, opt_constraint] := N_AST(node);*/
  105.         adasem(N_AST1(node));
  106.         adasem(N_AST2(node));
  107.         break;
  108.  
  109.     /* derived_type_definition  -> ['derived_type'    subtype_indication]*/
  110.     case(as_derived_type):
  111.         break;
  112.  
  113.     /* discrete_range  ->  ['range' expression  expression]*/
  114.     case(as_range):
  115.         /*[expression1, expression2] := N_AST(node);*/
  116.         adasem(N_AST1(node));
  117.         adasem(N_AST2(node));
  118.         break;
  119.  
  120.     /* range_attribute ->  ['range_attribute' name range]*/
  121.     case(as_range_attribute):
  122.         N_KIND(node) = as_attribute;
  123.         n2 = N_AST3(node);
  124.         find_old(node);
  125.         adasem(n2);
  126.         break;
  127.  
  128.     /* discrete_range  ->  ['range_expression'  expression]*/
  129.     case(as_range_expression):
  130.         adasem(N_AST1(node));
  131.         break;
  132.  
  133.     /* constraint  ->  ['constraint'  general_aggregate]*/
  134.     case(as_constraint):
  135.         sem_list(node);
  136.         break;
  137.  
  138.     /* enumeration_type  -> [as_enum  enumeration_literal_list]*/
  139.     case(as_enum):
  140.         sem_list(node);
  141.         break;
  142.  
  143.     case(as_int_type):
  144.         break;
  145.  
  146.     case(as_float_type):
  147.         break;
  148.  
  149.     case(as_fixed_type):
  150.         break;
  151.  
  152.     case(as_digits):
  153.     case(as_delta):
  154.         adasem(N_AST1(node));
  155.         adasem(N_AST2(node));
  156.         break;
  157.  
  158.     /* array_type_definition -> ['array_type' index_list subtype_indication]*/
  159.     case(as_array_type):
  160.         array_typedef(node);
  161.         break;
  162.  
  163.     /* subtype_definition  ->  ['box'  name]*/
  164.     case(as_box):
  165.         adasem(N_AST1(node));
  166.         break;
  167.  
  168.     /* discrete_range -> [as_subtype opt_name  range_constraint]
  169.      * general_component_association ->[as_subtype opt_name range-constraint]
  170.      */
  171.     case(as_subtype):
  172.         /*[opt_name, range_constraint] := N_AST(node);*/
  173.         n1 = N_AST1(node);
  174.         n2 = N_AST2(node);
  175.         if (n1 != OPT_NODE) {
  176.             adasem(n1);
  177.             find_old(n1);
  178.         }
  179.         if (n2 == OPT_NODE) {    /* possible, if syntax error */
  180.             N_KIND(node) = as_name;
  181.         }
  182.         else adasem(n2);
  183.         break;
  184.  
  185.     /* record_decl    -> [as_record component_list]*/
  186.     case(as_record):
  187.         adasem(N_AST1(node));
  188.         break;
  189.  
  190.     /* component_list  -> [ 'component_list'  component_decl_list variant]*/
  191.     case(as_component_list):
  192.         /*[component_decl_list, variant] := N_AST(node);*/
  193.         sem_list(N_AST1(node));
  194.         adasem(N_AST2(node));
  195.         break;
  196.  
  197.     /* component_declaration -> ['field' identifier_list subtype_indic
  198.      *                             opt_expression]
  199.      */
  200.     case(as_field):
  201.         comp_decl(node);
  202.         break;
  203.  
  204.     /* discr_specification -> ['discr_spec' identifier_list name opt_expr]*/
  205.     case(as_discr_spec):
  206.         /*[id_list_node, name, opt_expr] := N_AST(node);*/
  207.         adasem(N_AST2(node));
  208.         /*  adasem(N_AST3(node));   */
  209.         break;
  210.  
  211.     /* variant_part -> ['variant_decl' simple_name variant_list]*/
  212.     case(as_variant_decl):
  213.         variant_decl(node);
  214.         break;
  215.  
  216.     /* component_association -> ['choice_list'  choice_list     expression]*/
  217.     case(as_choice_list):
  218.         /*[choice_list, expression] := N_AST(node);*/
  219.         sem_list(N_AST1(node));
  220.         adasem(N_AST2(node));
  221.         break;
  222.  
  223.     case(as_simple_choice):
  224.         adasem(N_AST1(node));
  225.         break;
  226.  
  227.     case(as_range_choice):
  228.         adasem(N_AST1(node));
  229.         break;
  230.  
  231.     case(as_others_choice):
  232.         break;
  233.  
  234.     case(as_choice_unresolved):
  235.         adasem(N_AST1(node));
  236.         break;
  237.  
  238.     case(as_access_type):
  239.         n1 = N_AST1(node);
  240.         adasem(n1);
  241.         n2 = N_AST1(n1);
  242.         n3 = N_AST2(n1);
  243.         if (n3 == OPT_NODE ) {
  244.             /*Special case: type mark may be an incomplete type.*/
  245.             N_UNQ(n1) = find_type(n2);
  246.         }
  247.         else {    /* elaborate subtype indication*/
  248.             N_UNQ(n1) = promote_subtype(make_subtype(n1));
  249.         }
  250.         break;
  251.  
  252.     /* incomplete_type_decl -> ['incomplete_decl'  identifier  discriminant]*/
  253.     case(as_incomplete_decl):
  254.         incomplete_decl(node);
  255.         break;
  256.  
  257.     /* declarations -> ['declarations'  declaration_list]*/
  258.     case(as_declarations):
  259.         declarative_part(node);
  260.         break;
  261.  
  262.     /* Chapter 4. Names and expressions */
  263.  
  264.     /* name     -> ['character_literal'   character]
  265.      * Character literals also appear as enumeration literals, and as
  266.      * selectors.
  267.      */
  268.     case(as_character_literal):
  269.         break;
  270.  
  271.     /* name      ->  ['simple_name'  identifier]*/
  272.     case(as_simple_name):
  273.         break;
  274.  
  275.     /* name      ->  ['call?'    name  general_aggregate]*/
  276.     case(as_call_unresolved):
  277.         n1 = N_AST1(node);
  278.         n2 = N_AST2(node);
  279.  
  280.         if (N_KIND(n1) == as_string) {
  281.             /* Operator designator: reduce to lower case.*/
  282.             /*N_VAL(n1) = LOWER_CASE_OF(N_VAL(n1));*/
  283.             id = N_VAL(n1);
  284.             while(*id) {
  285.                 if (isupper(*id)) *id = tolower(*id);
  286.                 id++;
  287.             }
  288.         }
  289.         adasem(n1);
  290.         FORTUP(n1 = (Node), N_LIST(n2), ft1);
  291.             adasem(n1);
  292.         ENDFORTUP(ft1);
  293.         break;
  294.  
  295.     /* name ->  ['operator'     operator_symbol]*/
  296.     case(as_operator):
  297.         N_KIND(node) = as_simple_name;
  298.         break;
  299.  
  300.     case(as_string):
  301.         N_KIND(node) = as_simple_name;
  302.         break;
  303.  
  304.     /* name     ->  ['.' name selector]*/
  305.     case(as_selector):
  306.         adasem(N_AST1(node));
  307.         break;
  308.  
  309.     case(as_all):
  310.         adasem(N_AST1(node));
  311.         break;
  312.  
  313.     case(as_attribute):
  314.         adasem(N_AST2(node));
  315.         adasem(N_AST3(node));
  316.         break;
  317.  
  318.     /* aggregate  ->  [as_aggregate expression_list]*/
  319.     case(as_aggregate):
  320.         sem_list(node);
  321.         break;
  322.  
  323.     /* parenthesised_expression  ->     ['()', expression]*/
  324.     case(as_parenthesis):
  325.         adasem(N_AST1(node) );
  326.         break;
  327.  
  328.     /* expression  ->  [operator_designator     <expression..>]*/
  329.     case(as_op):
  330.     case(as_un_op):
  331.         /*[op_node, arg_list] := N_AST(node);*/
  332.         n1 = N_AST1(node);
  333.         op_id = N_VAL(n1);
  334.         /* KLUDGE until parser fixed. */
  335.         if (streq(op_id, "NOT")) N_VAL(n1) = strjoin("not", "");
  336.         else if (streq(op_id, "AND")) N_VAL(n1) = strjoin("and", "");
  337.         else if (streq(op_id, "XOR")) N_VAL(n1) = strjoin("xor", "");
  338.         else if (streq(op_id, "REM")) N_VAL(n1) = strjoin("rem", "");
  339.         else if (streq(op_id, "MOD")) N_VAL(n1) = strjoin("mod", "");
  340.         else if (streq(op_id, "OR"))  N_VAL(n1) = strjoin("or", "");
  341.         n2 = N_AST2(node);
  342.         find_old(n1);
  343.  
  344.         FORTUP(n3 = (Node), N_LIST(n2), ft1);
  345.             adasem(n3);
  346.             /*
  347.              * the call to check_range_attribute is useless, since
  348.              * adasem converts as_range_attribute to as_attribute
  349.              *                (gcs 11 feb)
  350.              */
  351.             /* check_range_attribute(n3); */
  352.         ENDFORTUP(ft1);
  353.         break;
  354.  
  355.     case(as_in):
  356.     case(as_notin):
  357.  
  358.         n3 = N_AST2(node);
  359.         tup = N_LIST(n3);
  360.         n1 = (Node) tup[1];
  361.         n2 = (Node) tup[2];
  362.         adasem(n1);
  363.         adasem(n2);
  364.         break;
  365.  
  366.     case(as_int_literal):
  367.         break;
  368.  
  369.     case(as_real_literal):
  370.         break;
  371.  
  372.     case(as_string_literal):
  373.         break;
  374.  
  375.     case(as_null):
  376.         break;
  377.  
  378.     case(as_name):
  379.         adasem(N_AST1(node));
  380.         break;
  381.  
  382.     case(as_qualify):
  383.         find_type(N_AST1(node));
  384.         adasem(N_AST2(node));
  385.         break;
  386.  
  387.     /* allocator  -> ['new_init' name aggregate]*/
  388.     case(as_new_init):
  389.         n1 = N_AST1(node);
  390.         n2 = N_AST2(node);
  391.         adasem(n1);
  392.         adasem(n2);
  393.         break;
  394.  
  395.     /* allocator  ->  ['new'  name    constraint_list]*/
  396.     case(as_new):
  397.         n1 = N_AST1(node);
  398.         n2 = N_AST2(node);
  399.         adasem(n1);
  400.         sem_list(n2);
  401.         break;
  402.  
  403.     /* Chapter 5. Statements*/
  404.  
  405.     /* sequence_of_statements  ->  ['statements' statement_list, label_list]*/
  406.     case(as_statements):
  407.         statement_list(node);
  408.         break;
  409.  
  410.     /* statement  ->  ['statement'    label_list  statement]*/
  411.     case(as_statement):
  412.         /*[label_list, stmt] := N_AST(node);*/
  413.         n1= N_AST1(node);
  414.         n2= N_AST2(node);
  415.  
  416.         FORTUP(l = (Node), N_LIST(n1), ft1);
  417.             find_old(l);
  418.             if (NATURE(N_UNQ(l)) != na_label) {
  419. #ifdef ERRNUM
  420.                 errmsgn(2, 3, l);
  421. #else
  422.                 errmsg("label hidden by inner declaration", "5.1", l);
  423. #endif
  424.             }
  425.         ENDFORTUP(ft1);
  426.  
  427.         adasem(n2);
  428.         break;
  429.  
  430.     /* labels_declaration  ->  ['labels'  label_list]*/
  431.     case(as_labels):
  432.         label_decl(node);
  433.         break;
  434.  
  435.     /* null_statement  -> [null_s']*/
  436.     case(as_null_s):
  437.         break;
  438.  
  439.  
  440.     /* assignment  -> [':='     name  expression ]*/
  441.     case(as_assignment):
  442.         assign_statement(node);
  443.         break;
  444.  
  445.     /* if_statement     ->  ['if' if_part_list opt_else]*/
  446.     case(as_if):
  447.         if_statement(node);
  448.         break;
  449.  
  450.     /* condition  ->  ['condition' expression]*/
  451.     case(as_condition):
  452.         n1 = N_AST1(node);
  453.         adasem(n1);
  454.         check_type(symbol_boolean_type, n1);
  455.         break;
  456.  
  457.     /* case_statement  ->  ['case' expression alt_list]*/
  458.     case(as_case):
  459.     case_statement(node);
  460.         break;
  461.  
  462.     /* loop_statement  ->  ['loop'    opt_loop_id iteration_rule statements]*/
  463.     case(as_loop):
  464.         loop_statement(node);
  465.         break;
  466.  
  467.     /* iteration_rule  ->  ['while'     condition]*/
  468.     case(as_while):
  469.         adasem(N_AST1(node));
  470.         break;
  471.  
  472.     /* iteration rule  ->  ['for'     identifier  discrete_range]*/
  473.     case(as_for):
  474.         iter_var(node);
  475.         break;
  476.  
  477.     /* iteration_rule  ->  ['forrev' identifier  discrete_range]*/
  478.     case(as_forrev):
  479.         iter_var(node);
  480.         break;
  481.  
  482.     /* block  ->  [na_block identifier declarations statements exceptions]*/
  483.     case(as_block):
  484.         new_block(node);
  485.         break;
  486.  
  487.     /* exit_statement ->  ['exit' opt_name opt_expression]*/
  488.     case(as_exit):
  489.         exit_statement(node);
  490.         break;
  491.  
  492.     /* return_statement  ->     ['return' opt_expression]*/
  493.     case(as_return):
  494.         return_statement(node);
  495.         break;
  496.  
  497.     case(as_goto):
  498.         goto_statement(node);
  499.         break;
  500.  
  501.     /* Chapter 6. Subprograms*/
  502.  
  503.     /* subprogram_declaration  ->  ['subprogram_decl', subprogram_spec]*/
  504.     case(as_subprogram_decl):
  505.         subprog_decl(node);
  506.         break;
  507.  
  508.     /* subprogram_specification -> [na_procedure identifier formals_list]
  509.      *               -> [na_function  identifier formals_list name]
  510.      */
  511.     case(as_procedure):
  512.         break;
  513.  
  514.     case(as_function):
  515.         find_type(N_AST3(node));
  516.         break;
  517.  
  518.     /* subprogram_body  ->    ['subprogram' subprogram_spec  declarations
  519.      *                       statements opt_exceptions]
  520.      */
  521.     case(as_subprogram):
  522.         subprog_body(node);
  523.         break;
  524.  
  525.     /* parameter_specification -> ['formal' id_list mode name opt_expression]*/
  526.     case(as_formal):
  527.         break;
  528.  
  529.     /* mode     -> ['mode'  identifier]*/
  530.     case(as_mode):
  531.         break;
  532.  
  533.     /* call_statement -> ['call' name]*/
  534.     case(as_call):
  535.         call_statement(node);
  536.         break;
  537.  
  538.     /* Chapter 7. Packages*/
  539.  
  540.     /* package_specification  ->  [na_package_spec identifier declarations
  541.      *                              opt_private_part]
  542.      */
  543.     case(as_package_spec):
  544.         package_specification(node);
  545.         break;
  546.  
  547.     /* package_body     ->  ['package_body' identifier declarations
  548.      *                     opt_statements     opt_handler]
  549.      */
  550.     case(as_package_body):
  551.         id_node = N_AST1(node);
  552.         decl_node = N_AST2(node);
  553.         n3 = N_AST3(node);
  554.         n4 = N_AST4(node);
  555.         module_body_id(na_package, id_node);
  556.         adasem(decl_node);
  557.         adasem(n3);
  558.         adasem(n4);
  559.         force_all_types();
  560.         module_body(na_package, node);
  561.         package = N_UNQ(id_node);
  562.         if (NATURE(package) == na_generic_package)
  563.             N_KIND(node) = as_generic_package;
  564.         break;
  565.  
  566.     /* private_type_declaration  ->     ['private_decl' identifier
  567.      *                      discriminant_list priv_kind]
  568.      */
  569.     case(as_private_decl):
  570.         private_decl(node);
  571.         break;
  572.  
  573.     /* Chapter 8. Visibility rules*/
  574.  
  575.     /* use_clause  -> [use' identifier_list]*/
  576.     case(as_use):
  577.         use_clause(node);
  578.         break;
  579.  
  580.     /* renaming_declaration -> ['rename_ex' identifier name]*/
  581.     case(as_rename_ex):
  582.         rename_ex(node);
  583.         break;
  584.  
  585.     /* renaming_declaration     ->  ['rename_pack' identifier    name]*/
  586.     case(as_rename_pack):
  587.         rename_pack(node);
  588.         break;
  589.  
  590.     /* renaming_declaration     ->  ['rename_obj' identifier type_mark name]*/
  591.     case(as_rename_obj):
  592.         rename_object(node);
  593.         break;
  594.  
  595.     /* renaming declarations  ->  ['rename_sub'  subprogam_spec  name]*/
  596.     case(as_rename_sub):
  597.         rename_subprogram(node);
  598.         break;
  599.  
  600.     /* Chapter 9. Tasks */
  601.  
  602.     /* task_specification  ->  [task_kind identifier opt_entry_declaration
  603.      *                             opt_rep_clause]
  604.      * task_kind           ->  'task_spec'
  605.      *              ->  na_task_type_spec
  606.      */
  607.     case(as_task_spec):
  608.     case(as_task_type_spec):
  609.         /* clear N_AST3 as specification not supported now, and
  610.          * need this field for N_TYPE   DS 9-21-86
  611.          */
  612.         N_AST3(node) = (Node)0;
  613.         task_spec(node);
  614.         break;
  615.  
  616.     /* task_body  ->  ['task' identifier declarations statements
  617.      *                            opt_exceptions]
  618.      */
  619.     case(as_task):
  620.         /*[id_node, decls, stmts, excepts] := N_AST(node);*/
  621.         id_node = N_AST1(node);
  622.         n2 = N_AST2(node);
  623.         n3 = N_AST3(node);
  624.         n4 = N_AST4(node);
  625.         module_body_id(na_task_type, id_node);
  626.         /* clear the private_decls field set in module_body_id as this is */
  627.         /* irrelevant to tasks. */
  628.         private_decls(N_UNQ(id_node)) = (Set)0;
  629.         adasem(n2);
  630.         adasem(n3);
  631.         adasem(n4);
  632.         module_body(na_task_type, node);
  633.         s1 = N_UNQ(id_node);
  634.         check_incomplete_decls(s1, node);
  635.         break;
  636.  
  637.     /* entry_declaration   ->  [na_entry identifier formals_list]*/
  638.     case(as_entry):
  639.         entry_decl(node);
  640.         break;
  641.  
  642.     /* * entry_declaration   ->  [na_entry_family identifier discrete_range
  643.      *                               formals_list]
  644.      */
  645.     case(as_entry_family):
  646.         entry_family_decl(node);
  647.         break;
  648.  
  649.     /* accept_statement  ->     ['accept' name opt_expression opt_formal_part
  650.      *                              opt_statements]
  651.      */
  652.     case(as_accept):
  653.         accept_statement(node);
  654.         break;
  655.  
  656.     /* delay_statement  -> ['delay'     expression]*/
  657.     case(as_delay):
  658.         n1 = N_AST1(node);
  659.         adasem(n1);
  660.         check_type(symbol_duration, n1);
  661.         break;
  662.  
  663.     /* selective_wait  ->  ['selective_wait' alternative_list else_part]*/
  664.     case(as_selective_wait):
  665.         n1 = N_AST1(node);
  666.         n2 = N_AST2(node);
  667.         sem_list(n1);
  668.         if (n2 != OPT_NODE)
  669.             adasem(n2);
  670.         break;
  671.  
  672.     /* select_alternative -> ['guard' condition selective_wait_alternative]*/
  673.     case(as_guard):
  674.         adasem(N_AST1(node));
  675.         adasem(N_AST2(node));
  676.         break;
  677.  
  678.     /* selective_wait_alternative -> ['accept_alt' accept_statement opt_stats]
  679.      *                 -> ['delay_alt'  delay_statement  opt_stats]
  680.      */
  681.     case(as_accept_alt):
  682.         adasem(N_AST1(node));
  683.         adasem(N_AST2(node));
  684.         break;
  685.  
  686.     case(as_delay_alt):
  687.         adasem(N_AST1(node));
  688.         adasem(N_AST2(node));
  689.         break;
  690.  
  691.     /* selective_wait_alternative  -> ['terminate_alt' ]*/
  692.     case(as_terminate_alt):
  693.         terminate_statement(node);
  694.         break;
  695.  
  696.     /* conditional_entry_call -> ['conditional_entry_call' call_statement
  697.      *                        statements else_stat]
  698.      */
  699.     case(as_conditional_entry_call):
  700.         check_entry_call(N_AST1(node));
  701.         adasem(N_AST2(node));
  702.         adasem(N_AST3(node));
  703.         break;
  704.  
  705.     /* timed_entry_call -> ['timed_entry_call', call_statement statements
  706.      *                           delay_alternative]
  707.      */
  708.     case(as_timed_entry_call):
  709.         check_entry_call(N_AST1(node));
  710.         adasem(N_AST2(node));
  711.         adasem(N_AST3(node));
  712.         break;
  713.  
  714.     /* abort_statement  -> ['abort'     task_name_list]*/
  715.     case(as_abort):
  716.         abort_statement(node);
  717.         break;
  718.  
  719.     /* Chapter 10. Program structure...*/
  720.  
  721.     /* (as_compilation):
  722.      * This node is used for pragmas that precede a compilation unit.
  723.      * TBSL
  724.      */
  725.  
  726.     /* unit_declaration  ->     ['unit' context_clause     unit_body]*/
  727.     case(as_unit):
  728.         compunit(node);
  729.         break;
  730.  
  731.     /* context_clause  -> ['with_use_list' [with_or_use...]]
  732.      * No action is necessary since this is handled in comp_unit
  733.      * body_stub    ->  ['subprogam_stub' subprogram_specification]
  734.      *           ->  ['package_stub'  name]
  735.      *           ->  ['task_stub'        name]
  736.      */
  737.  
  738.     case(as_subprogram_stub):
  739.         {
  740.             Symbol u_name;
  741.             n1 = N_AST1(node);
  742.             n2 = N_AST1(n1);
  743.             u_name = dcl_get(DECLARED(scope_name), N_VAL(n2));
  744.             /* For generic stubs ignore call to check_spec. 
  745.              * TBSL: code for checking formals.
  746.              * Note: if uname is undefined here it indicates that the stub had
  747.              * no subprog declaration and therefore is certainly not generic.
  748.              */
  749.             if (u_name != (Symbol)0
  750.               && (NATURE(u_name) == na_generic_procedure_spec
  751.               || NATURE(u_name) == na_generic_function_spec)) {
  752.                 N_UNQ(n2) = u_name;
  753.                 newscope(u_name);
  754.                 adasem(n1);
  755.                 popscope();
  756.                 save_stub(node);
  757.             }
  758.             else {
  759.                 adasem(n1);
  760.                 check_spec(node);
  761.                 u_name = N_UNQ(n2);
  762.                 NATURE(u_name) = N_KIND(n1) == as_procedure ? na_procedure_spec
  763.                   : na_function_spec;
  764.                 if (in_op_designators(ORIG_NAME(u_name) ) ){
  765. #ifdef ERRNUM
  766.                     l_errmsgn(6, 7, 8, n2);
  767. #else
  768.                     errmsg_l("Name of separately compiled unit cannot be ",
  769.                       "an operator designator", "10.1", n2);
  770. #endif
  771.                 }
  772.                 else {
  773.                     save_stub(node);
  774.                 }
  775.             }
  776.         }
  777.         break;
  778.  
  779.     case(as_package_stub):
  780.         stub_head(na_package, node);
  781.         save_stub(node);
  782.         break;
  783.  
  784.     case(as_task_stub):
  785.         stub_head(na_task, node);
  786.         save_stub(node);
  787.         break;
  788.  
  789.     /* subunit  -> ['separate' parent_name unit]*/
  790.     case(as_separate):
  791.         adasem(N_AST2(node));
  792.         break;
  793.  
  794.     /* Chapter 11. Exceptions*/
  795.  
  796.     /* Exception_declaration  ->  ['except_decl'  identifier_list]*/
  797.     case(as_except_decl):
  798.         except_decl(node);
  799.         break;
  800.  
  801.     /* exceptions  -> ['exception' handler_list]*/
  802.     case(as_exception):
  803.         exception_part(node);
  804.         break;
  805.  
  806.     /* exception_handler  ->  ['handler'  exception_choice_list statements]*/
  807.     case(as_handler):
  808.         exception_handler(node);
  809.         break;
  810.  
  811.     case(as_others):
  812.         break;
  813.  
  814.     /* raise_statement -> ['raise  opt_identifier]*/
  815.     case(as_raise):
  816.         raise_statement(node);
  817.         break;
  818.  
  819.     /* Chapter 12. Generics*/
  820.     case(as_generic_procedure):
  821.     case(as_generic_function):
  822.         generic_subprog_spec(node);
  823.         break;
  824.  
  825.     case(as_generic_package):
  826.         generic_pack_spec(node);
  827.         break;
  828.  
  829.     /* Generic part     ->  ['generic_formals' generic_decl_list]*/
  830.     case(as_generic_formals):
  831.         /*$$$newtypes with:= []; $ Anonymous types may be created (???)*/
  832.         sem_list(node);
  833.         /*$$$ generic_list := []+/sem_list(2);     and new_type_list*/
  834.         break;
  835.  
  836.     /* Generic_formal -> ['generic_obj' id_list mode name opt_expression]*/
  837.     case(as_generic_obj):
  838.         generic_obj_decl(node);
  839.         break;
  840.  
  841.     /* Generic formal  -> ['generic_type' identifier type_def]*/
  842.     case(as_generic_type):
  843.         generic_type_decl(node);
  844.         break;
  845.  
  846.     /* Generic formal  -> ['gen_priv_type'    private_type_declaration]*/
  847.     case(as_gen_priv_type):
  848.         generic_priv_decl(node);
  849.         break;
  850.  
  851.     /* Generic_formal   ->    ['generic_subp', subprogram_spec  opt_is]*/
  852.     case(as_generic_subp):
  853.         generic_subp_decl(node);
  854.         break;
  855.  
  856.     /* Generic_type_definition  ->    ['generic' identifier]*/
  857.     case(as_generic):
  858.         break;
  859.  
  860.     /* Package_instance -> ['package_instance' identifier name instance_list]*/
  861.     case(as_package_instance):
  862.         package_instance(node);
  863.         break;
  864.  
  865.     /* subprogram_instance
  866.      *    ->  ['function_instance'  designator  name  generic_actual_part]
  867.      *    ->  ['procedure_instance' identifier  name  generic_actual_part]
  868.      */
  869.     case(as_function_instance):
  870.     case(as_procedure_instance):
  871.         subprog_instance(node);
  872.         break;
  873.  
  874.     /* generic_parameter_association->['instance' opt_identifier expression]*/
  875.     case(as_instance):
  876.         break;
  877.  
  878.     /* Chapter 13. Representation specs...*/
  879.  
  880.     /* length_clause -> ['length_clause' attribute simple_expression ]*/
  881.     case(as_length_clause):
  882.         length_clause (node);
  883.         break;
  884.  
  885.     /*
  886.      * enumeration_representation_clause -> ['enum_rep_clause'
  887.      *                       simple_name aggregate ]
  888.      */
  889.     case(as_enum_rep_clause):
  890.          enum_rep_clause (node); 
  891.         break;
  892.  
  893.     /*
  894.      * record_representation_clause ->
  895.      *    ['rec_rep_clause' simple_name opt_align_clause comp_clause_list ]
  896.      */
  897.     case(as_rec_rep_clause):
  898.         rec_rep_clause(node);
  899.         break;
  900.  
  901.     /* component_clause -> ['compon_clause' name simple_expression range]*/
  902.     case(as_compon_clause):
  903.         adasem(N_AST1(node));
  904.         adasem(N_AST2(node));
  905.         adasem(N_AST3(node));
  906.         break;
  907.  
  908.     /* address_clause -> ['address_clause' simple_name simple_expression]*/
  909.     case(as_address_clause):
  910.         break;
  911.  
  912.     case(as_opt): 
  913.         break;
  914.  
  915.     case(as_line_no):
  916.         break;
  917.  
  918.     default:
  919.         if (node == (Node)0) return;
  920.         /* above is single line added re OPT_NODE  4 jul*/
  921.         printf("adasem: invalid node %d kind %d\n", node, N_KIND(node));
  922. #ifdef ERRNUM
  923.         str_errmsgn(9, kind_str(N_KIND(node)), 10, node);
  924. #else
  925.         errmsg_str("System error: invalid node %", kind_str(N_KIND(node)),
  926.           "none", node);
  927. #endif
  928.     }
  929. }
  930.  
  931. void sem_list(Node n)                                        /*;sem_list*/
  932. {
  933.     Fortup ft1;
  934.     Node    ln;
  935.  
  936.     if (N_LIST(n) == (Tuple)0) return;
  937.     FORTUP(ln = (Node), N_LIST(n), ft1);
  938.         adasem(ln);
  939.     ENDFORTUP(ft1);
  940. }
  941.